home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 050 / bix02.arc / TSETS.PAS < prev    next >
Pascal/Delphi Source File  |  1986-08-04  |  5KB  |  168 lines
  1. (*Turbo/Generic - assorted procs/funcs for set operations on sets of 0..2039
  2.    For those few of you for whom Turbo's 0..255 is too restrictive, here's
  3. a collection of routines that treat a 'string[255]' as a superset of 0..2039.
  4. There's a procedure 'show' that display a set's elements as well as a text
  5. message. For ease of coding, there's a routine 'Lit' that, given a normal
  6. set literal (i.e. [1,7,34..55,178..202]) returns a LongSet. Since you cannot
  7. have an element greater than 255 in normal Turbo sets, to set additional
  8. elements you do "S1 := SetOn(S1,1987)" which is equivalent to "s1:=s1+[1987]"
  9. IF Turbo handled such large numbers.
  10. The program contains some examples of usage. The first few examples have
  11. as comments the equivalent set operation expression for normal sets. The last
  12. dozen examples display set contents on the screen after various operations.
  13. It's suggested that you have a printout of the source while you're viewing
  14. the screen's display to get a flavor for proper usage.   - Jim Keohane*)
  15.  
  16. Program TSets;
  17.  
  18. TYPE LongSet=STRING[255];
  19.      LitSet= set of 0..255;
  20.      str40=string[40];
  21.  
  22. VAR S1,S2,S3:LongSet;
  23.     i:integer;
  24.  
  25. Procedure LongEnuf(I:Integer;var LS:LongSet);
  26. begin
  27.  if i > length(LS) then
  28.   begin
  29.    FillChar(LS[succ(length(ls))],i-length(ls),0);
  30.    ls[0]:=chr(i)
  31.   end
  32. end;
  33.  
  34.  
  35. Function SetOff(LS:LongSet;I:Integer):LongSet;
  36. var j:integer;
  37. begin
  38.  j:=1+I shr 3;
  39.  if j> Length(LS) then LongEnuf(j,LS);
  40.  ls[j]:=chr(ord(ls[j]) and ($ff7f shr (7-(i and $7))));
  41.  SetOff:=ls
  42. end;
  43.  
  44. Function SetOn(LS:LongSet;I:Integer):LongSet;
  45. var j:integer;
  46. begin
  47.  j:=1+I shr 3;
  48.  if j> Length(LS) then LongEnuf(j,LS);
  49.  ls[j]:=chr(ord(ls[j]) or ($0080 shr (7-(i and $7))));
  50.  SetOn:=ls
  51. end;
  52.  
  53. Function InSet(I:integer;S:LongSet):boolean;
  54. var j:integer;
  55. begin
  56.  j := 1 + i shr 3;
  57.  if j >length(s) then InSet:=false else
  58.  InSet:=ord(s[j]) and ($0080 shr (7-(i and $7))) <> 0
  59. end;
  60.  
  61.  
  62. Function Union(S1,S2:LongSet):LongSet;
  63. var s:longset;
  64.     i:integer;
  65. begin
  66.  s:=s1;
  67.  if length(s1)<length(s2) then LongEnuf(length(s2),s);
  68.  for i:=1 to length(s2) do s[i]:=chr(ord(s[i]) or ord(s2[i]));
  69.  Union:=s
  70. end;
  71.  
  72. Function Diff(S1,S2:LongSet):LongSet;
  73. var s:longset;
  74.     i:integer;
  75. begin
  76.  s:=s1;
  77.  for i:=1 to length(s) do s[i]:=chr(ord(s[i]) and  (not ord(s2[i])));
  78.  Diff:=s
  79. end;
  80.  
  81. Function Intersect(S1,S2:LongSet):LongSet;
  82. var s:longset;
  83.     i:integer;
  84. begin
  85.  if length(s1)<length(s2) then s[0]:=s1[0] else s[0]:=s2[0];
  86.  for i:=1 to length(s) do s[i]:=chr(ord(s1[i]) and ord(s2[i]));
  87.  while (s[0]>#0) and (s[length(s)]=#0) do s[0]:=pred(s[0]);
  88.  Intersect:=s
  89. end;
  90.  
  91. Function Lit(l:litset):LongSet;
  92. var s:longset;
  93. begin
  94.  s[0]:=' ';
  95.  move(l,s[1],32);
  96.  while (s[0]>#0) and (s[length(s)]=#0) do s[0]:=pred(s[0]);
  97.  Lit:=s
  98. end;
  99.  
  100. Function Leq(S1,S2:LongSet):boolean;
  101. begin
  102.  if s1=s2 then Leq:=true else
  103.  Leq := s1 = Intersect(s1,s2)
  104. end;
  105.  
  106. Function Geq(S1,S2:LongSet):boolean;
  107. begin
  108.  if s1=s2 then Geq:=true else
  109.  Geq := s2 = Intersect(s1,s2)
  110. end;
  111.  
  112. Procedure Show(txt:str40;S:LongSet);
  113. var i,j:integer;
  114. begin
  115.  j:=length(s) shl 3 -1;
  116.  write(txt,' ':40-length(txt));
  117.  for i:=0 to j do if inset(i,s) then write(i:8);
  118.  writeln
  119. end;
  120.  
  121.  
  122. BEGIN
  123.  
  124.  S1 := '';      {S1 := [] }
  125.  S1 := SetOn(S1,100);    { S1 := S1 + [100] }
  126.  S2 := S1;    {straight assignment}
  127.  IF InSet(100,S1) THEN;   {IF 100 IN S1 }
  128.  S1 := SetOff(S1,100);    { S1 := S1 - [100] }
  129.  S3 := Union(S1,S2);  { S1 := S1 + S2 }
  130.  S3 := Intersect(S1,S2); { S3 := S1 * S2 }
  131.  S3 := Diff(S1,S2);    {S3 := S1 - S2 }
  132.  IF S2 = S3 then; {if s2 = s3 }
  133.  IF Leq(S1,s2) then; { if s1 <= s2 }
  134.  IF Geq(S1,S2) then; { if s1>=s2 }
  135.  S3 := Lit([1,5,35..78,126]);    { s3 := [1,5,35..78,126] }
  136.  IF Intersect(S1,S2)='' then; { if s1*s2=[] }
  137.  
  138. {test some routines}
  139. S1:='';
  140. show('null',s1);
  141. s1:=lit([1..5,200,232]);
  142. show('[1..5,200,232]',s1);
  143. s1:='';
  144. s1:=seton(s1,1);s1:=seton(s1,2);s1:=seton(s1,3);s1:=seton(s1,4);
  145. s1:=seton(s1,5);s1:=seton(s1,200);s1:=seton(s1,232);
  146. show('[1..5,200,232]',s1);
  147. s2:=lit([199..201]);
  148. s3:=union(s1,s2);
  149. show('[1..5,199..201,232]',s3);
  150. s3:=intersect(s1,s2);
  151. show('[200]',s3);
  152. show('s1=',s1);
  153. show('s2=',s2);
  154. if not geq(s1,s2) then writeln('s1 IS NOT >= s2');
  155. s2:=setoff(s2,199);
  156. s2:=setoff(s2,201);
  157. show('s2 is now = to ',s2);
  158. if geq(s1,s2) then writeln('s1 IS NOW >= s2');
  159. s1:='';
  160. for i:= 2000 to 2010 do s1:=seton(s1,i);
  161. show('2000 thru 2010',s1);
  162. s2:='';s2:=seton(s2,2005);
  163. s3:=diff(s1,s2);
  164. show('2000..2004,2006..2010',s3);
  165. s3:=setoff(s3,2006);
  166. show('2000..2004,2007..2010',s3);
  167. end.
  168.